home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / modem / ezdia175.zip / TESTBED.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-27  |  30KB  |  951 lines
  1.  
  2. program testbed;
  3.  
  4. {$R testbed.RES}
  5.  
  6. uses wincrt, WObjects, WinTypes, WinProcs, strings, StdDlgs, StdWnds,
  7.      dialunit;
  8.  
  9. const
  10.   IO_AREA_SIZE = 65000;
  11.   CURSOR_CHAR  = '|';
  12.   cm_specparam = 101;
  13.   cm_establink = 102;
  14.   cm_hangup    = 103;
  15.   cm_callbbs   = 104;
  16.   cm_xmodemdown= 105;
  17.   cm_xmodemup  = 106;
  18.   cm_xmod1kdown= 107;
  19.   cm_xmod1kup  = 108;
  20.   cm_ymodemdown= 109;
  21.   cm_ymodemup  = 110;
  22.   cm_interrupt = 111;
  23.   cm_addresponse=112;
  24.   cm_linktoport =113;
  25.  
  26.   cm_exit      = 001;
  27.  
  28.   cm_download  = 201;
  29.   cm_upload    = 202;
  30.   cm_movedown  = 203;
  31.   cm_moveup    = 204;
  32.   cm_update    = 205;
  33.   cm_mailupdate= 206;
  34.  
  35.   cm_zipserver = 301;
  36.   cm_zipclient = 302;
  37.  
  38.   cm_unzipserver = 401;
  39.   cm_unzipclient = 402;
  40.  
  41.   cm_runserver = 501;
  42.   cm_runclient = 502;
  43.   cm_lnchserver= 503;
  44.   cm_lnchclient= 504;
  45.  
  46.   cm_delServer = 601;
  47.   cm_delClient = 602;
  48.  
  49.   cm_UseHelp      = 905;
  50.   cm_HelpAbout    = 999;
  51.                    
  52.   cm_DialupStatus     = 145;
  53.   cm_DialupBanner     = 146;
  54.   cm_DialupBytes      = 147;
  55.   cm_DialupElapsed    = 148;
  56.   cm_DialupBPS        = 149;
  57.   cm_DialupPercent    = 150;
  58.   cm_CommandCompleted = 151;
  59.   cm_ZipStatus        = 152;
  60.  
  61.   cm_CommNotify       = 160;
  62.   cm_EventNotify      = 161;
  63.  
  64.   id_messagearea      = 101;
  65.   id_notifyarea       = 902;
  66.  
  67. type
  68.   TTestBedApp = object(TApplication)
  69.                   procedure InitMainWindow; virtual;
  70.                   procedure InitInstance; virtual;
  71.                 end;
  72.  
  73.  pMultiFieldDlg  = ^TMultiFieldDlg;
  74.  TMultiFieldDlg= object(Tdialog)
  75.                    NumFields:integer;
  76.                    Chk:pcheckbox;
  77.                    procedure SetupWindow; virtual;
  78.                    procedure EndDlg(ARetValue: Integer); virtual;
  79.                    constructor Init(AParent: PWindowsObject; AName: PChar;aNumFields:integer);
  80.                  end;
  81.  
  82.   PStatusWindow= ^TStatusWindow;
  83.   TStatusWindow = object(TDlgWindow)
  84.                     MessagesArea:plistbox;
  85.                     NotificationsArea:plistbox;
  86.                     MyParent : pWindow;
  87.                     constructor Init(AParent: PWindowsObject;
  88.                                      AName: PChar);
  89.                     procedure SetupWindow; virtual;
  90.                     procedure WMSetFocus(var Msg: TMessage);
  91.                        virtual WM_First + WM_setfocus;
  92.                   end;
  93.  
  94.   PTTestBedWindow = ^TTestBedWindow;
  95.   TTestBedWindow = object(TWindow)
  96.                      MyScroller : pscroller;
  97.                      StatusWindow : pStatusWindow;
  98.                      IORow,IOLine:integer;
  99.  
  100.                      IOWindow     : pdialog;
  101.                      IOChannelOpen:boolean;
  102.                      CallInProgress:boolean;
  103.                      HangupRequested:boolean;
  104.                      NumLines     :word;
  105.                      LinesPerScreen:word;
  106.                      LastKey:char;
  107.                      IOArea       :pchar;
  108.                      IOAreaIndex  :word;
  109.                      CommandSerialNumber:word;
  110.  
  111.  
  112.                      constructor Init(AParent: PWindowsObject; ATitle: PChar);
  113.                      destructor Done; virtual;
  114.                      procedure SetupWindow; virtual;
  115.                      procedure GetWindowClass(var AWndClass:TWndCLass); virtual;
  116.  
  117.                      procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  118.                      function CanClose: boolean; virtual;
  119.                      procedure WMChar(var Msg: TMessage);
  120.                        virtual WM_First + WM_char;
  121.                      function RunDialog(Title,Label1,Label2,Label3:string;
  122.                                   NumFields:integer):boolean; virtual;
  123.                      procedure PrepNotifications; virtual;
  124.  
  125.                      (* Responses to user input... *)
  126.  
  127.                      {File...}
  128.                      procedure FileExit(var Msg: TMessage);
  129.                        virtual cm_First + cm_exit;
  130.  
  131.                      {Connection...}
  132.                      procedure SpecParam(var Msg: TMessage);
  133.                        virtual cm_First + cm_specparam;
  134.                      procedure EstabLink(var Msg: TMessage);
  135.                         virtual cm_First + cm_establink;
  136.                      procedure AddAutoResponse(var Msg: TMessage);
  137.                        virtual cm_First + cm_addresponse;
  138.                      procedure CallBBS(var Msg: TMessage);
  139.                        virtual cm_First + cm_callbbs;
  140.                      procedure LinkToPort(var Msg: TMessage);
  141.                        virtual cm_First + cm_linktoport;
  142.                      procedure Hangup(var Msg: TMessage);
  143.                        virtual cm_First + cm_hangup;
  144.  
  145.                      {Transfer...}
  146.                      procedure DownLoad(var Msg: TMessage);
  147.                        virtual cm_First + cm_download;
  148.                      procedure UpLoad(var Msg: TMessage);
  149.                        virtual cm_First + cm_upload;
  150.                      procedure MoveDown(var Msg: TMessage);
  151.                        virtual cm_First + cm_movedown;
  152.                      procedure MoveUp(var Msg: TMessage);
  153.                        virtual cm_First + cm_moveup;
  154.                      procedure UpdateClient(var Msg: TMessage);
  155.                        virtual cm_First + cm_update;
  156.                      procedure UpdateEZMail(var Msg: TMessage);
  157.                        virtual cm_First + cm_mailupdate;
  158.  
  159.                      {Zip...}
  160.                      procedure ZipServer(var Msg: TMessage);
  161.                        virtual cm_First + cm_zipserver;
  162.                      procedure ZipClient(var Msg: TMessage);
  163.                        virtual cm_First + cm_zipclient;
  164.                      procedure UnZipServer(var Msg: TMessage);
  165.                        virtual cm_First + cm_unzipserver;
  166.                      procedure UnZipClient(var Msg: TMessage);
  167.                        virtual cm_First + cm_unzipclient;
  168.  
  169.                      {Execute...}
  170.                      procedure RunServer(var Msg: TMessage);
  171.                        virtual cm_First + cm_runserver;
  172.                      procedure RunClient(var Msg: TMessage);
  173.                        virtual cm_First + cm_runclient;
  174.                      procedure LnchServer(var Msg: TMessage);
  175.                        virtual cm_First + cm_lnchserver;
  176.                      procedure LnchClient(var Msg: TMessage);
  177.                        virtual cm_First + cm_lnchclient;
  178.  
  179.                      {Delete...}
  180.                      procedure DelServer(var Msg: TMessage);
  181.                        virtual cm_First + cm_delserver;
  182.                      procedure DelClient(var Msg: TMessage);
  183.                        virtual cm_First + cm_delclient;
  184.  
  185.                      {X-Ymodem}
  186.                      procedure XmodemDownload(var Msg: TMessage);
  187.                        virtual cm_First + cm_xmodemdown;
  188.                      procedure XmodemUpload(var Msg: TMessage);
  189.                        virtual cm_First + cm_xmodemup;
  190.                      procedure Xmodem1KDownload(var Msg: TMessage);
  191.                        virtual cm_First + cm_xmod1kdown;
  192.                      procedure Xmodem1KUpload(var Msg: TMessage);
  193.                        virtual cm_First + cm_xmod1kup;
  194.                      procedure YmodemDownload(var Msg: TMessage);
  195.                        virtual cm_First + cm_ymodemdown;
  196.                      procedure YmodemUpload(var Msg: TMessage);
  197.                        virtual cm_First + cm_ymodemup;
  198.                      procedure InterruptTransfer(var Msg: TMessage);
  199.                        virtual cm_First + cm_interrupt;
  200.  
  201.                      {Help}
  202.                      procedure UseHelp(var Msg: TMessage);
  203.                        virtual cm_First + cm_UseHelp;
  204.                      procedure HelpAbout(var Msg: TMessage);
  205.                        virtual cm_First + cm_HelpAbout;
  206.  
  207.                      (* Responses to EZdialup messages... *)
  208.                      procedure NewDialupStatus(var Msg:Tmessage);
  209.                        virtual wm_user + cm_DialupStatus;
  210.                      procedure NewDialupBanner(var Msg:Tmessage);
  211.                        virtual wm_user + cm_DialupBanner;
  212.                      procedure NewDialupBytes(var Msg:Tmessage);
  213.                        virtual wm_user + cm_DialupBytes;
  214.                      procedure NewDialupElapsed(var Msg:Tmessage);
  215.                        virtual wm_user + cm_DialupElapsed;
  216.                      procedure NewDialupBPS(var Msg:Tmessage);
  217.                        virtual wm_user + cm_DialupBPS;
  218.                      procedure NewDialupPercent(var Msg:Tmessage);
  219.                        virtual wm_user + cm_DialupPercent;
  220.                      procedure CommandCompleted(var Msg:Tmessage);
  221.                        virtual wm_user + cm_CommandCompleted;
  222.                      procedure NewZipStatus(var Msg:Tmessage);
  223.                        virtual wm_user + cm_ZipStatus;
  224.  
  225.                      procedure SerialIONotify(var Msg:Tmessage);
  226.                        virtual wm_user + cm_commnotify;
  227.                      procedure EventNotify(var Msg:Tmessage);
  228.                        virtual wm_user + cm_eventnotify;
  229.  
  230.  
  231.   end;
  232.  
  233.  
  234. var
  235.   FieldResults:array[1..10] of string;
  236.   FieldLabels:array[1..10] of string;
  237.   DialogTitle:string;
  238.   CheckBoxChecked:boolean;
  239.   TextHeight   :word;
  240.  
  241.  
  242.                                      
  243. Procedure AddNul(var s:string);
  244. begin
  245.     (* Make pascal string null-terminated *)
  246.     s[length(s)+1] := chr(0);
  247. end;                          
  248.  
  249.  
  250.  
  251. constructor TStatusWindow.Init(AParent: PWindowsObject; AName: PChar);
  252. begin
  253.    TdlgWindow.init(AParent,ANAme);
  254.    MyParent := pointer(aparent);
  255.    MessagesArea := New(Plistbox, InitResource(@self, id_messagearea));
  256.    NotificationsArea := New(Plistbox, InitResource(@self, id_notifyarea));
  257. end;
  258.  
  259.  
  260. procedure TStatusWindow.SetupWindow;
  261. var s:string;
  262.    ParentRect,winrect:trect;
  263. begin
  264.    TdlgWindow.SetupWindow;
  265. end;
  266.  
  267.  
  268. procedure TStatusWindow.WMSetFocus(var Msg: TMessage);
  269. begin
  270.   defwndproc(msg);
  271.   Setfocus(parent^.hwindow);
  272. end;
  273.  
  274. constructor TMultiFieldDlg.init(AParent: PWindowsObject; AName: PChar;aNumFields:integer);
  275. begin
  276.     tdialog.init(aparent,aname);
  277.     NumFields := ANumFields;
  278.     chk := new(pcheckbox,InitResource(@self, 150));
  279. end;
  280.  
  281. procedure TMultiFieldDlg.SetupWindow;
  282. var i:integer;
  283. begin
  284.     tdialog.Setupwindow;
  285.  
  286.     for i := 1 to NumFields do addnul(FieldResults[i]);
  287.  
  288.     for i := 1 to NumFields do
  289.        SetDlgItemText(hwindow,100+i,@FieldResults[i][1]);
  290.  
  291.     for i := 1 to NumFields do
  292.       if FieldLabels[i] <> ''
  293.       then begin
  294.         Addnul(FieldLabels[i]);
  295.         SetDlgItemText(hwindow,200+i,@FieldLabels[i][1]);
  296.       end;
  297.  
  298.     addnul(DialogTitle);
  299.     SetWindowText(hwindow,@DialogTitle[1]);
  300.  
  301.     chk^.check;
  302.  
  303. end;
  304.  
  305. procedure TMultiFieldDlg.EndDlg(ARetValue: Integer);
  306. var i,j:integer;
  307.     name:array[0..144] of char;
  308.     s:string;
  309. begin
  310.    i := ARetValue;
  311.    if i = id_ok then begin
  312.  
  313.         for j := 1 to NumFields do begin
  314.             GetDlgItemText(hwindow,100+j,name,144);
  315.             s := strpas(name);
  316.             if s = '' then begin
  317.                i := 3;
  318.             end
  319.             else begin
  320.               FieldResults[j] := s;
  321.               addnul(FieldResults[j]);
  322.             end;
  323.         end;
  324.         CheckBoxChecked := (chk^.Getcheck = 1);
  325.    end;
  326.    Tdialog.EndDlg(i);
  327.  
  328. end;
  329.  
  330. procedure TTestBedWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  331. var
  332.   oldfont:hfont;
  333.   rect:trect;
  334.   tm:ttextmetric;
  335. begin
  336.     oldfont := SelectObject(PaintDC,GetStockObject(ANSI_FIXED_FONT));
  337.     GetClientRect(hwindow,rect);
  338.  
  339.     rect.bottom := GetTextExtent(PaintDC,ioarea,ioareaindex+1);
  340.  
  341.     DrawText(paintdc,ioarea,ioareaindex+1,rect,0);
  342.     if TextHeight = 0 then begin
  343.          GetClientRect(hwindow,rect);
  344.          GetTextMetrics(PaintDC,tm);
  345.          TextHeight := tm.tmheight;
  346.          LinesPerScreen := (rect.bottom-rect.top) div TextHeight;
  347.          MyScroller^.SetUnits(1,textHeight);
  348.     end;
  349.     SelectObject(PaintDC,oldfont);
  350. end;
  351.  
  352.  
  353. function  TTestBedWindow.CanClose: boolean;
  354. begin
  355.     CanClose := true;
  356.     if CallInProgress and (not HangupRequested) then begin
  357.        MessageBox(getfocus,
  358.                   'Run Connection|Hangup before exiting program',
  359.                   'Can not terminate Testbed',0);
  360.        canclose := false;
  361.     end; 
  362. end;
  363.  
  364.  
  365. procedure TTestBedWindow.WMChar(var Msg: TMessage);
  366. begin
  367.       if not IOChannelOpen then begin
  368.          exit;
  369.       end;
  370.       SendSerialByte(msg.wparam);  {** APPDIAL.DLL **}
  371.       Lastkey := chr(msg.wparam);
  372.       defwndproc(msg);
  373. end;
  374.  
  375.  
  376. {File...}
  377. procedure TTestBedWindow.FileExit(var Msg: TMessage);
  378. begin
  379.    PostMessage(hwindow,wm_close,0,0);
  380. end;
  381.  
  382. {Connection...}
  383. procedure TTestBedWindow.SpecParam(var Msg: TMessage);
  384. var i:integer;
  385. begin
  386.  
  387.      FieldResults[1] := '9,555-1212';
  388.      FieldResults[2] := 'COM2';
  389.      FieldResults[3] := '19200,n,8,1';
  390.      FieldResults[4] := 'ATZ';
  391.      FieldResults[5] := 'AT E0 V1 X4 S0=0';
  392.      FieldResults[6] := 'k:\ezdialup\someuser';
  393.      FieldResults[7] := 'userpassword';
  394.      FieldResults[8] := 'ezdialup.exe';
  395.      
  396.      for i := 1 to 8 do FieldLabels[i] := '';
  397.  
  398.      repeat
  399.        (* Display dialog until no empty fields or Cancel pressed... *)
  400.        i := Application^.ExecDialog(New(pMultiFieldDlg, Init(@Self, 'SessionSpecs',8)))
  401.      until i <> 3;
  402.      if i = 1 then begin
  403.        (* Ok was pressed; give EZDialup its configuration... *)
  404.        (* These routines MUST be executed before server-control *)
  405.        (* commands are allowed*)
  406.        SetDialingSequence(@FieldResults[1][1]);   {** APPDIAL.DLL **}
  407.        SetDialupCommPort(@FieldResults[2][1]);    {** APPDIAL.DLL **}
  408.        SetDialupCommConfig(@FieldResults[3][1]);  {** APPDIAL.DLL **}
  409.        SetModemInit1(@FieldResults[4][1]);        {** APPDIAL.DLL **}
  410.        SetModemInit2(@FieldResults[5][1]);        {** APPDIAL.DLL **}
  411.        
  412.        SetDownloadBlockSize(4096);                {** APPDIAL.DLL **}
  413.        SetUploadBlockSize(4096);                  {** APPDIAL.DLL **}
  414.        SetLinkUserPath(@FieldResults[6][1]);      {** APPDIAL.DLL **}
  415.        SetLinkUserPassword(@FieldResults[7][1]);  {** APPDIAL.DLL **}
  416.        
  417.        SetExecutablePath(@FieldResults[8][1]);    {** APPDIAL.DLL **}
  418.        
  419.     end;
  420.  
  421.     for i := 1 to 8 do FieldResults[i] := '';
  422. end;
  423.  
  424. procedure TTestBedWindow.EstabLink(var Msg: TMessage);
  425. begin
  426.    if CallInprogress then exit;
  427.    CallInProgress := true;
  428.    HangupRequested := false;
  429.    EstablishDialupLink;                           {** APPDIAL.DLL **}
  430. end;
  431.  
  432.  
  433. procedure TTestBedWindow.AddAutoResponse(var Msg: TMessage);
  434. var s:string;
  435. begin
  436.     if RunDialog('Add Auto-Response','Search String:','Response:','',99)
  437.     then begin
  438.        s := concat(FieldResults[1],' -> ',FieldResults[2]);
  439.        if CheckBoxChecked then s := concat(s,' (plus CR)');
  440.        addnul(s);
  441.        with StatusWindow^.NotificationsArea^ do begin
  442.          AddString(@s[1]);
  443.          SetSelIndex(GetCount-1);
  444.       end;
  445.    end;
  446. end;
  447.  
  448. procedure TTestBedWindow.PrepNotifications;
  449. var s,s2,s3:string;
  450.     i,j,k:integer;
  451.     AddCR:boolean;
  452.     ThisCRC:word;
  453.     P:ARRAY[0..144] OF CHAR;
  454. begin
  455.    if StatusWindow^.NotificationsArea^.GetCount > 0 then
  456.     for i := 1 to StatusWindow^.NotificationsArea^.GetCount do begin
  457.         J := StatusWindow^.NotificationsArea^.getstring(p,i-1);
  458.         s := strpas(p);
  459.         j := pos('->',s);
  460.         s2 := copy(s,1,j-2);
  461.         s3 := copy(s,j+3,length(s));
  462.         k := pos('(plus CR)',s3);
  463.         AddCr := (k > 0);
  464.         if k > 0
  465.          then s3 := copy(s3,1,k-2);
  466.         addnul(s2);
  467.         if AddCR then s3 := concat(s3,chr(13));
  468.         addnul(s3);
  469.         SetupNotification(@s2[1],@s3[1],0,0); {** APPDIAL.DLL **}
  470.    end;
  471. end;
  472.  
  473. procedure TTestBedWindow.CallBBS(var Msg: TMessage);
  474. var s:string;
  475. begin
  476.  
  477.  
  478.   if CallInprogress then exit;
  479.   CallInProgress := true;
  480.   HangupRequested := false;
  481.   ioareaindex := 0;
  482.   ioarea[0] := CURSOR_CHAR;
  483.   ioarea[1] := chr(0);
  484.   NumLines := 0;
  485.  
  486. (*Examples:
  487.   SetupNotification('login: ','my-id',0,0);              {** APPDIAL.DLL **}
  488.   SetupNotification('password: ','my-password',0,0);     {** APPDIAL.DLL **}
  489. *)
  490.  
  491.   PrepNotifications;
  492.   EstablishLinkAsTerminal;                        {** APPDIAL.DLL **}
  493.  
  494. end;
  495.  
  496. procedure TTestBedWindow.LinkToPort(var Msg: TMessage);
  497. begin
  498.   if CallInprogress then exit;
  499.   CallInProgress := true;
  500.   HangupRequested := false;
  501.   ioareaindex := 0;
  502.   ioarea[0] := CURSOR_CHAR;
  503.   ioarea[1] := chr(0);
  504.   NumLines := 0;
  505.  
  506.   PrepNotifications;
  507.   EstablishCommPortLink;                          {** APPDIAL.DLL **}
  508. end;
  509.  
  510. procedure TTestBedWindow.Hangup(var Msg: TMessage);
  511. begin
  512.   if IOChannelOpen then begin
  513.       ShowWindow(StatusWindow^.hwindow,sw_show);
  514.       MyScroller^.ScrollTo(0,0);
  515.       IOChannelOpen := false;
  516.   end;
  517.  
  518.   HangupRequested := true;
  519.   AbortSession;                                   {** APPDIAL.DLL **}
  520. end;
  521.  
  522. {Transfer...}
  523. procedure TTestBedWindow.Download(var Msg: TMessage);
  524. begin
  525.     if RunDialog('Download A File','Server File','Client File','',2)
  526.     then CommandSerialNumber
  527.          := StartDownload(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  528. end;
  529.  
  530. procedure TTestBedWindow.Upload(var Msg: TMessage);
  531. begin
  532.     if RunDialog('Upload A File','Server File','Client File','',2)
  533.     then CommandSerialNumber
  534.          := StartUpLoad(@FieldResults[2][1],@FieldResults[1][1]); {** APPDIAL.DLL **}
  535. end;
  536.  
  537. procedure TTestBedWindow.MoveDown(var Msg: TMessage);
  538. var p:pchar;
  539. begin
  540.     if RunDialog('Move File Down','Server File','Client File','',2)
  541.     then CommandSerialNumber
  542.          := StartMoveDown(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  543. end;
  544.  
  545. procedure TTestBedWindow.MoveUp(var Msg: TMessage);
  546. var p:pchar;
  547. begin
  548.     if RunDialog('Move File Up','Server File','Client File','',2)
  549.     then CommandSerialNumber
  550.          := StartMoveUp(@FieldResults[2][1],@FieldResults[1][1]); {** APPDIAL.DLL **}
  551. end;
  552.  
  553. procedure TTestBedWindow.UpdateClient(var Msg: TMessage);
  554. var p:pchar;
  555. begin
  556.     if RunDialog('Update Client Directory Structure',
  557.                  'Client Directory',
  558.                  'Server Directory',
  559.                  'Client Date File',3)
  560.     then CommandSerialNumber
  561.          := UpdateClientDirectory(@FieldResults[1][1],
  562.                                   @FieldResults[2][1],
  563.                                   @FieldResults[3][1]); {** APPDIAL.DLL **}
  564. end;
  565.  
  566. procedure TTestBedWindow.UpdateEZmail(var Msg: TMessage);
  567. var p:pchar;
  568. begin
  569.     if RunDialog('Update EZMail','Server Mailbox','Client Directory','',2)
  570.     then CommandSerialNumber
  571.          := EZMailUpdate(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  572. end;
  573.  
  574. {Zip...}
  575. procedure TTestBedWindow.ZipServer(var Msg: TMessage);
  576. begin
  577.     if RunDialog('Zip Server File(s)','Target File','Source File(s)','',2)
  578.     then CommandSerialNumber
  579.          := ZipServerFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  580. end;
  581.  
  582. procedure TTestBedWindow.ZipClient(var Msg: TMessage);
  583. begin
  584.     if RunDialog('Zip Client File(s)','Target File','Source File(s)','',2)
  585.     then CommandSerialNumber
  586.          := ZipClientFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  587. end;
  588.  
  589. procedure TTestBedWindow.UnZipServer(var Msg: TMessage);
  590. begin
  591.     if RunDialog('Un-Zip Server File(s)','Source Zip File','Target Directory','',2)
  592.     then CommandSerialNumber
  593.          := UnZipServerFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  594. end;
  595.  
  596. procedure TTestBedWindow.UnZipClient(var Msg: TMessage);
  597. begin
  598.     if RunDialog('Un-Zip Client File(s)','Source Zip File','Target Directory','',2)
  599.     then CommandSerialNumber
  600.          := UnZipClientFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
  601. end;
  602.  
  603. {Execute...}
  604. procedure TTestBedWindow.RunServer(var Msg: TMessage);
  605. begin
  606.     if RunDialog('Run and Wait for Server Program','Program Path','','',1)
  607.     then CommandSerialNumber
  608.          := RunProgramOnServer(@FieldResults[1][1]); {** APPDIAL.DLL **}
  609. end;
  610.  
  611. procedure TTestBedWindow.RunClient(var Msg: TMessage);
  612. begin
  613.     if RunDialog('Run and Wait for Client Program','Program Path','','',1)
  614.     then CommandSerialNumber
  615.          := RunProgramOnClient(@FieldResults[1][1]); {** APPDIAL.DLL **}
  616. end;
  617.  
  618. procedure TTestBedWindow.LnchServer(var Msg: TMessage);
  619. begin
  620.     if RunDialog('Run and Forget Server Program','Program Path','','',1)
  621.     then CommandSerialNumber
  622.          := LaunchProgramOnServer(@FieldResults[1][1]); {** APPDIAL.DLL **}
  623. end;
  624.  
  625. procedure TTestBedWindow.LnchClient(var Msg: TMessage);
  626. begin
  627.     if RunDialog('Run and Forget Client Program','Program Path','','',1)
  628.     then CommandSerialNumber
  629.          := LaunchProgramOnClient(@FieldResults[1][1]); {** APPDIAL.DLL **}
  630. end;
  631.  
  632. {Delete...}
  633. procedure TTestBedWindow.DelServer(var Msg: TMessage);
  634. begin
  635.     if RunDialog('Delete File(s) on Server','File(s)','','',1)
  636.     then CommandSerialNumber
  637.          := DeleteFilesOnServer(@FieldResults[1][1]); {** APPDIAL.DLL **}
  638. end;
  639.  
  640. procedure TTestBedWindow.DelClient(var Msg: TMessage);
  641. begin
  642.     if RunDialog('Delete File(s) on Client','File(s)','','',1)
  643.     then CommandSerialNumber
  644.          := DeleteFilesOnClient(@FieldResults[1][1]); {** APPDIAL.DLL **}
  645. end;
  646.  
  647. {X-Ymodem}
  648. procedure TTestBedWindow.XmodemDownload(var Msg: TMessage);
  649. begin
  650.     if RunDialog('Download File (X)','Local File Name','','',1)
  651.     then begin
  652.        ShowWindow(StatusWindow^.hwindow,sw_show);
  653.        MyScroller^.ScrollTo(0,0);
  654.        IOChannelOpen := false;
  655.        StartTerminalDownload(@FieldResults[1][1],1);  {** APPDIAL.DLL **}
  656.     end;
  657.  
  658. end;
  659.  
  660. procedure TTestBedWindow.XmodemUpload(var Msg: TMessage);
  661. begin
  662.     if RunDialog('Upload File (X)','Local File Name','','',1)
  663.     then begin
  664.        ShowWindow(StatusWindow^.hwindow,sw_show);
  665.        MyScroller^.ScrollTo(0,0);
  666.        IOChannelOpen := false;
  667.        StartTerminalUpload(@FieldResults[1][1],1);    {** APPDIAL.DLL **}
  668.     end;
  669. end;
  670.  
  671. procedure TTestBedWindow.Xmodem1KDownload(var Msg: TMessage);
  672. begin
  673.     if RunDialog('Download File (1K)','Local File Name','','',1)
  674.     then begin
  675.        ShowWindow(StatusWindow^.hwindow,sw_show);
  676.        MyScroller^.ScrollTo(0,0);
  677.        IOChannelOpen := false;
  678.        StartTerminalDownload(@FieldResults[1][1],2);  {** APPDIAL.DLL **}
  679.     end;
  680.  
  681. end;
  682.  
  683. procedure TTestBedWindow.Xmodem1KUpload(var Msg: TMessage);
  684. begin
  685.     if RunDialog('Upload File (1K)','Local File Name','','',1)
  686.     then begin
  687.        ShowWindow(StatusWindow^.hwindow,sw_show);
  688.        MyScroller^.ScrollTo(0,0);
  689.        IOChannelOpen := false;
  690.        StartTerminalUpload(@FieldResults[1][1],2);    {** APPDIAL.DLL **}
  691.     end;
  692. end;
  693.  
  694. procedure TTestBedWindow.YmodemDownload(var Msg: TMessage);
  695. begin
  696.     if RunDialog('Download File (Y)','Local File Name','','',1)
  697.     then begin
  698.        ShowWindow(StatusWindow^.hwindow,sw_show);
  699.        MyScroller^.ScrollTo(0,0);
  700.        IOChannelOpen := false;
  701.        StartTerminalDownload(@FieldResults[1][1],3);  {** APPDIAL.DLL **}
  702.     end;
  703.  
  704. end;
  705.  
  706. procedure TTestBedWindow.InterruptTransfer(var Msg: TMessage);
  707. begin
  708.     InterruptFileTransfer;                            {** APPDIAL.DLL **}
  709. end;
  710.  
  711. procedure TTestBedWindow.YmodemUpload(var Msg: TMessage);
  712. begin
  713.     if RunDialog('Upload File (Y)','Local File Name','','',1)
  714.     then begin
  715.        ShowWindow(StatusWindow^.hwindow,sw_show);
  716.        MyScroller^.ScrollTo(0,0);
  717.        IOChannelOpen := false;
  718.        StartTerminalUpload(@FieldResults[1][1],3);    {** APPDIAL.DLL **}
  719.     end;
  720. end;
  721.  
  722. {Help}
  723. procedure TTestBedWindow.UseHelp(var Msg:TMessage);
  724. begin
  725.       WinHelp(HWindow, 'EZDIALUP.HLP', 3, 0);
  726. end;
  727.  
  728. procedure TTestBedWindow.HelpABout(var Msg:TMessage);
  729. var
  730.    result:integer;
  731. begin
  732.    Application^.ExecDialog(new(pdialog,init(@self,'help')));
  733. end;
  734.  
  735. procedure TTestBedWindow.NewDialupStatus(var Msg:Tmessage);
  736. var p:pchar;
  737. s:string;
  738.  
  739. begin
  740.   p := pointer(msg.lparam);
  741.   s := strpas(p);
  742.   if (s = 'EZDialup Shutdown')
  743.   or (s = 'EZDialup Load Failed')
  744.   then CallInProgress := false;
  745.  
  746.   with StatusWindow^.MessagesArea^ do begin
  747.     AddString(p);
  748.     SetSelIndex(GetCount-1);
  749.   end;
  750.  
  751. end;
  752.  
  753. procedure TTestBedWindow.NewDialupBanner(var Msg:Tmessage);
  754. begin
  755.   SetDlgItemText(StatusWindow^.hwindow,100,pointer(msg.lparam));
  756. end;
  757.  
  758. procedure TTestBedWindow.NewDialupBytes(var Msg:Tmessage);
  759. begin
  760.   SetDlgItemText(StatusWindow^.hwindow,102,pointer(msg.lparam));
  761. end;
  762.  
  763. procedure TTestBedWindow.NewDialupPercent(var Msg:Tmessage);
  764. begin
  765.   SetDlgItemText(StatusWindow^.hwindow,103,pointer(msg.lparam));
  766. end;
  767.  
  768. procedure TTestBedWindow.NewDialupBPS(var Msg:Tmessage);
  769. begin
  770.   SetDlgItemText(StatusWindow^.hwindow,104,pointer(msg.lparam));
  771. end;
  772.  
  773. procedure TTestBedWindow.NewDialupElapsed(var Msg:Tmessage);
  774. begin
  775.   SetDlgItemText(StatusWindow^.hwindow,105,pointer(msg.lparam));
  776. end;
  777.  
  778. procedure TTestBedWindow.CommandCompleted(var Msg:Tmessage);
  779. var s,s2:string;
  780. begin                                 
  781.     s := strpas(pointer(msg.lparam));
  782.     str(msg.wparam,s2);
  783.     s := concat('Completed command: ',s2,' - ',s);
  784.     addnul(s);
  785.     with StatusWindow^.MessagesArea^ do begin
  786.       AddString(@s[1]);
  787.       SetSelIndex(GetCount-1);
  788.     end;
  789. end;
  790.  
  791. procedure TTestBedWindow.NewZipStatus(var Msg:Tmessage);
  792. begin
  793.   SetDlgItemText(StatusWindow^.hwindow,106,pointer(msg.lparam));
  794. end;
  795.  
  796. procedure TTestBedWindow.SerialIONotify(var Msg:Tmessage);
  797. var i:integer;
  798.     c:char;
  799.     str:array[0..2] of char;
  800. begin
  801.    if not IOChannelOpen then begin
  802.       ShowWindow(StatusWindow^.hwindow,sw_hide);
  803.    end;
  804.    IOChannelOpen := true;
  805.    if msg.wparam > 0
  806.     then  
  807.      for i := 1 to msg.wparam do begin
  808. {   While SerialIoWaiting do begin}  {<-Alternative logic} {** APPDIAL.DLL **}
  809.       c:= chr(GetSerialByte);                              {** APPDIAL.DLL **}
  810.  
  811.       if c in [chr(8),chr(13),' '..'z'] then begin
  812.         ioarea[ioareaindex] := C;
  813.         inc(ioareaindex);
  814.         if ioareaindex > IO_AREA_SIZE then begin
  815.            NumLines := 1;
  816.            ioareaindex := 0;
  817.         end;
  818.  
  819.         case ord(c) of
  820.              {Special screen clean-up for CR's and Backspaces...}
  821.                8:begin  {BackSpace}
  822.                     dec(ioareaindex,1);
  823.                     if ioareaindex < 0 then ioareaindex := 0;
  824.                     ioarea[ioareaindex-1] := CURSOR_CHAR;
  825.                     ioarea[ioareaindex] := ' ';
  826.                     ioarea[ioareaindex+1] := chr(0);
  827.                     SendMessage(hwindow,wm_paint,0,0);
  828.                     dec(ioareaindex,1);
  829.                  end;
  830.               13:begin {CR}
  831.                     ioarea[ioareaindex-1] := ' ';
  832.                     ioarea[ioareaindex] := c;
  833.                     ioarea[ioareaindex+1] := chr(0);
  834.                     Inc(NumLines);
  835.                     MyScroller^.SetRange(1,NumLines);
  836.                     if numlines > (LinesperScreen-3) then       
  837.                     MyScroller^.ScrollTo(0,NumLines-LinesperScreen+3);
  838.                     SendMessage(hwindow,wm_paint,0,0);
  839.                     inc(ioareaindex);
  840.                  end;
  841.         end;
  842.  
  843.  
  844.         ioarea[ioareaindex] := CURSOR_CHAR;
  845.         ioarea[ioareaindex+1] := chr(0);
  846.  
  847.         InvalidateRect(hwindow,nil,false);
  848.  
  849.     end;
  850.  
  851.    end;
  852. end;
  853.  
  854. procedure TTestBedWindow.EventNotify(var Msg:Tmessage);
  855. begin
  856.    {Override this notification so it doesn't occur again...}
  857.    SetupNotification('','',msg.wparam,0);              {** APPDIAL.DLL **}
  858. end;
  859.  
  860. constructor TTestBedWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  861. begin
  862.   cmdshow := sw_maximize;
  863.   TWindow.Init(AParent,Atitle);
  864.   Attr.Menu := LoadMenu(HInstance, 'Commands');
  865.   attr.style := attr.style or ws_vscroll;
  866.   MyScroller := New(Pscroller, Init(@Self,8,15,1,1));
  867.   scroller := MyScroller;
  868.   MyScroller^.TrackMode := true{false};
  869. end;
  870.  
  871. destructor TTestbedWindow.done; 
  872. begin
  873.   freemem(ioarea,IO_AREA_SIZE);
  874.   TWindow.done;
  875. end;
  876.  
  877.  
  878. procedure TTestBedWindow.SetupWindow;
  879. var pt:tpoint;
  880. msg:tmessage;
  881. i:integer;
  882. begin
  883.   TWindow.SetupWindow;
  884.   StatusWindow := New(PStatusWindow,Init(@Self,'Messages'));
  885.   Application^.MakeWindow(StatusWindow);
  886.  
  887.   Getmem(ioarea,IO_AREA_SIZE);
  888.   ioareaindex := 0;
  889.   NumLines := 0;
  890.  
  891.   IOChannelOpen := false;
  892.   CallInProgress := false;
  893.   HangupRequested := false;
  894.   SetParentWindow(hwindow);                            {** APPDIAL.DLL **}
  895.   SupplyRegistrationCodes('','');                      {** APPDIAL.DLL **}
  896. end;
  897.  
  898. procedure TTestBedWindow.GetWindowClass(var AWndClass:TWndClass);
  899. begin
  900.     TWindow.GetWindowClass(AWndClass);
  901.     AWndClass.hIcon := LoadIcon(HInstance, 'icon1');
  902. end;
  903.  
  904. function TTestBedWindow.RunDialog(Title,Label1,Label2,Label3:string;
  905.                                   NumFields:integer):boolean;
  906. var i,j:integer;
  907.     s:string;
  908. begin
  909.      DialogTitle := Title;
  910.      FieldLabels[1] := Label1;
  911.      FieldLabels[2] := Label2;
  912.      FieldLabels[3] := Label3;
  913.      j := numfields;
  914.      repeat
  915.         case NumFields of
  916.           1 :s := 'OneField';
  917.           2 :s := 'TwoFields';
  918.           3 :s := 'ThreeFields';
  919.          99 :begin
  920.                  s := 'AutoResponse';
  921.                  j := 2;
  922.              end;
  923.         end;
  924.         addnul(s);
  925.         i := Application^.ExecDialog(New(pMultiFieldDlg, Init(@Self, @s[1],j)))
  926.      until i <> 3;
  927.      if i = 1
  928.      then RunDialog := true
  929.      else RunDialog := false;
  930. end;
  931.  
  932. procedure TTestBedApp.InitMainWindow;
  933. begin
  934.   MainWindow := New(PTTestBedWindow, Init(nil,'Dialup-Client Testbed Program - source included'));
  935. end;
  936.  
  937. procedure TTestBedApp.InitInstance;
  938. begin
  939.   TApplication.InitInstance;
  940. end;
  941.  
  942.  
  943. var
  944.   TestBedApp : TTestBedApp;
  945. begin
  946.  
  947.   TestBedApp.Init('TestBedApp');
  948.   TestBedApp.Run;
  949.   TestBedApp.Done;
  950. end.
  951.